home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textwndw.swg / 0017_Text User Interface.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  6.6 KB  |  226 lines
  1. {
  2. Heres a little Text User Interface! If you use this program and like it then
  3. tell me! All it has is four routines: WinD,WindMen,Shade, and Menu. Here it is:
  4. }
  5.  
  6. Unit TUI;
  7. Interface
  8. Uses CRT;
  9. Const Winsets = 1;
  10.       WinComponents = 10;
  11.  
  12.  
  13. Var
  14.     Item     : array[1..23] of String[80];
  15.  
  16.  
  17. Function Menu( NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
  18.                StartX,StartY:Byte) : Byte;
  19. Procedure Wind(Y1,X1,Y2,X2,FGCol,BGCol : Integer);
  20. Function WindMen(NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
  21.                WinFG,WinBG,StartX,StartY:Byte) : Byte;
  22. Procedure Shade (FG,BG : Byte;Ch : Char);
  23. Implementation
  24. Function Menu( NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
  25.                StartX,StartY:Byte) : Byte;
  26. Var MenuStrings : Array[1..25] of String;
  27.     NowX,NowY,LastX,LastY,SaveAttr,SaveX,SaveY : Byte;
  28.     ItemNow,LastItem : Byte;
  29.     InChar : Array[1..5] of Char;
  30.     TmpStr : String;
  31.     Count1,Count2,Count3,Count4  : Byte;
  32.     Done   : Boolean;
  33.     StartItem : Byte;
  34.  
  35. Begin
  36. SaveX:=WhereX;
  37. SaveY:=WhereY;
  38. StartItem:=1;
  39. SaveAttr:=TextAttr;
  40. NowX:=StartX;
  41. NowY:=StartY;
  42. LastX:=NowX;
  43. LastY:=NowY;
  44. ItemNow:=StartItem;
  45. LastItem:=StartItem;
  46. TextColor(NormalFG);
  47. TextBackGround(NormalBG);
  48. For Count2:=1 to NumItems do begin
  49.      GotoXY(StartX,(Count2+StartY)-1);
  50.      Write(Item[Count2]);
  51.                                End;
  52. Done:=False;
  53. Repeat
  54. GotoXY(LastX,LastY);
  55. TextColor(NormalFG);
  56. TextBackGround(NormalBG);
  57. Write(Item[LastItem]);
  58. GotoXY(NowX,NowY);
  59. TextColor(LightBarFG);
  60. TextBackGround(LightBarBG);
  61. Write(Item[ItemNow]);
  62. Repeat
  63. Until Keypressed;
  64. Inchar[1]:=ReadKey;
  65. If Inchar[1]=#0 then begin Inchar[1]:=ReadKey;
  66. LastX:=NowX;
  67. LastY:=NowY;
  68. LastItem:=ItemNow;
  69.  Case InChar[1] of
  70.                  'P' : Begin Inc(NowY); Inc(ItemNow) End;
  71.                  'H' : Begin Dec(NowY); Dec(ItemNow) End;
  72.                  'K' : Begin Dec(NowY); Dec(ItemNow) End;
  73.                  'M' : Begin Inc(NowY); Inc(ItemNow) End;
  74.  End;
  75. If ItemNow>NumItems then begin ItemNow:=1; NowY:=StartY; End;
  76. If ItemNow<1 then begin ItemNow:=NumItems; NowY:=NowY+NumItems; End;
  77.  
  78.                      End;
  79. If Inchar[1]=#27 then begin Menu:=255; Done:=True; End;
  80. If Inchar[1]=#13 then begin Menu:=ItemNow; Done:=True; End;
  81.  
  82. Until Done;
  83. TextAttr:=SaveAttr;
  84. GotoXY(SaveX,SaveY);
  85. End;
  86.  
  87. Procedure Wind(Y1,X1,Y2,X2,FGCol,BGCol : Integer);
  88. Var
  89. Count : Array [1..4] of Byte;
  90. TmpVar : Array [1..10] of Integer;
  91.  WinSet : Array [1..WinSets,1..WinComponents] of Char;
  92.  
  93. Begin
  94.           Winset[1,01]:='█'; {Top left}
  95.           Winset[1,02]:='▀'; {Top}
  96.           Winset[1,03]:='█'; {Top right}
  97.           Winset[1,04]:='▌'; {Left side}
  98.           Winset[1,05]:='▐'; {Right side}
  99.           Winset[1,06]:='█'; {Bottom Left}
  100.           Winset[1,07]:='▄'; {Bottom}
  101.           Winset[1,08]:='█'; {Bottom Right}
  102.           Winset[1,09]:='▒'; {Shadow}
  103. TextColor(FGCol);
  104. TextBackGround(BGCol);
  105. GotoXY(X1,Y1);
  106. Write(WinSet[1,01]);
  107. For Count[1]:=X1+1 to X2-2 do begin
  108.                    Write(Winset[1,02]);
  109.                    End;
  110. Write(WinSet[1,03]);
  111. For Count[1]:=Y1+1 to Y2-1 do begin
  112.       TextColor(FGCol);
  113.       TextBackGround(BGCol);
  114.       GotoXy(X1,Count[1]);
  115.       Write(WinSet[1,04]);
  116.       GotoXy(X2-1,Count[1]);
  117.       Write(WinSet[1,05]);
  118.       If FGCol > 7 then TextColor(FgCol-8) Else TextColor(8);
  119.       TextBackGround(0);
  120.       Write(Winset[1,09]);
  121.       End;
  122.       GotoXY(X1,Y2);
  123.       TextColor(FGCol);
  124.       TextBackGround(BGCol);
  125.                    For Count[1]:=X1 to X2-2 do begin
  126.                    If count[1]<>X1 then Write(Winset[1,07]) else
  127. write(Winset[1,06]);;                   End;
  128.                    Write(WinSet[1,08]);
  129.       If FGCol > 7 then TextColor(FgCol-8) Else TextColor(8);
  130.       TextBackGround(0);
  131.       Write(Winset[1,09]);
  132.       GotoXY(X1+1,Y2+1);
  133.        For Count[1]:=X1+1 to X2 do begin
  134.        Write(Winset[1,09]);
  135.        End;
  136.  
  137. End;
  138.  
  139. Function WindMen(NumItems, LightBarFG,LightBarBG,NormalFG,NormalBG,
  140.                WinFG,WinBG,StartX,StartY:Byte) : Byte;
  141. Var SaveX,SaveY,SaveAttr,Selec : Byte;
  142. Begin
  143. SaveX:=WhereX;
  144. SaveY:=WhereY;
  145. SaveAttr:=TextAttr;
  146. Wind(StartY-1,StartX-1,(StartY)+NumItems,StartX+Length(Item[1])+1,WinFG,WinBG);
  147. Selec:=Menu(NumItems,LightbarFG,LightbarBG,NormalFG,NormalBG,StartX,StartY);
  148. GotoXY(SaveX,SaveY);
  149. TextAttr:=SaveAttr;
  150. WindMen:=Selec;
  151. End;
  152.  
  153. Procedure Shade (FG,BG : Byte;Ch : Char);
  154. Var CNT : Integer;
  155. Begin
  156. ClrScr;
  157. TextColor(FG);
  158. TextBackGround(BG);
  159. For CNT:=1 to 125 do write('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒');
  160. End;
  161.  
  162.  
  163. End.
  164.  
  165.  
  166. { Heres a test program for TUI.PAS ... }
  167.  
  168. Uses CRT,Tui;
  169.  
  170. Var Selected : Byte;
  171. CNT      : Integer;
  172. Begin
  173. Shade(13,0,'▒');
  174. WinD(2,2,4,24,9,0);
  175. GotoXY(3,3);
  176. TextColor(10);
  177. WriteLn('                    ');
  178. Repeat
  179. Item[1]:='.∙·──────»>Item 1<«──────∙·.';
  180. Item[2]:='.∙·──────»>Item 2<«──────∙·.';
  181. Item[3]:='.∙·──────»>Item 3<«──────∙·.';
  182. Item[4]:='.∙·──────»>Item 4<«──────∙·.';
  183. Selected:=WindMen(4,14,3,15,1,13,1,30,5);
  184. If Selected<255 then Begin
  185.                            GotoXY(3,3);
  186.                            TextColor(10);
  187.                            WriteLn('You selected item #',Selected)
  188.                            end
  189.                 Else Begin
  190.                            GotoXY(3,3);
  191.                            TextColor(10);
  192.                   Write('       ESC!         ');
  193.                   WinD(20,30,22,50,12,0);
  194.                   TextColor(14+16);
  195.                   GotoXY(31,21);
  196.                   Write(' Press Any Key... ');
  197.                   Break; End;
  198. Until 1=0;
  199. Repeat until keypressed;
  200. ClrScr;
  201. End.
  202.  
  203. {
  204. Ok heres what this means. The syntax for WinD is :
  205. WinD(Col1,Row1,Col2,Row2,ForgroundColor,BackGroundColor);
  206. When you put in the forground color make sure it is atleast 7.. This is because
  207. when the routine prints the SHADOW it prints it in the low intensity version of
  208. the color... so make sure when you give a color there it's high intensity.
  209. Ok now for MENU. This is a function. what you do is load Item[1..23] with a
  210. string. These should all be equal in length or your menu will look really
  211. ragged...Ok call menu like this:
  212. ByteVar:=Menu(NumItems,LightbarFG,LightbarBG,NormalFG,normalBG,StartX,StartY);
  213. And bytevar will equal item# or 255 if ESC was pressed...
  214. Or:
  215. ByteVar:=WindMen(NumItems,LBFG,LBBG,NFG,NBG,WindowFG,WindowBG,StartX,StartY);
  216. All this is a combination between window and menu. It will draw a window
  217. around your menu items :)...
  218. And for the last one:
  219. Shade(FG,BG,CHAR);
  220. Just use it like to shade in magenta with a green background <YUCK!> do
  221. Shade(13,2,'▒');
  222.  
  223. If you use it please give me credit and maybe a registered version of the
  224. program?
  225. }
  226.